(require* sketch/parse/rule/common/line)
(require* sketch/parse/rule/common/block)
(require* sketch/parse/rule/common/arrow)

(import sketch.shape.domain.*)
(import sketch.shape.domain.LinkEnd$TYPE)

(deffunction is-box (?b)
	""
	(return (or
            (= 0 (str-compare "FCBlock" (?b getName)))
            (= 0 (str-compare "FCChoice" (?b getName)))
            (= 0 (str-compare "UMLClass" (?b getName)))
            (= 0 (str-compare "UMLInterface" (?b getName))))))

(deffunction is-arrow (?a)
    ""
    (return (or
            (= 0 (str-compare "DiamondArrowHead" (?a getName)))
            (= 0 (str-compare "OpenArrowHead" (?a getName)))
            (= 0 (str-compare "TriangleArrowHead" (?a getName))))))

(defrule linkend2-plain
    ""
	(declare (salience 20))
    ?fl <- (shape (name "Line") (obj ?l))
    ?f1 <- (shape (obj ?r1&:(is-box ?r1)))
    ?f2 <- (shape (obj ?r2&:(is-box ?r2)&~?r1))
    (test (call ShapePredicate onPointRectangle (?l getP1) ?r1))
    (test (call ShapePredicate onPointRectangle (?l getP2) ?r2))
    =>
    (printout "recognize linkend2 = line")

    (bind ?sh1 (new LinkEnd))
    (?sh1 setEndShape ?r1)
    (bind ?l1 (new Line (?l getP1) (?l getCenter)))
    (?sh1 setEnd ?l1)
    (?sh1 append ?l1)

    (bind ?sh2 (new LinkEnd))
    (?sh2 setEndShape ?r2)
    (bind ?l2 (new Line (?l getP2) (?l getCenter)))
    (?sh2 setEnd ?l2)
    (?sh2 append ?l2)

    (retract ?fl)
    (retract ?f1)
    (retract ?f2)

    (assert (shape
            (name "LinkEnd")
            (obj ?sh1)
            (children ?l)))
    (assert (shape
            (name "LinkEnd")
            (obj ?sh2)
            (children ?l)))

	(recognize ?sh1 (list-children (create$ ?l)))
    (recognize ?sh2 (list-children (create$ ?l))))

(defrule linkend-plain
    ""
    (declare (salience 10))
    ?fr <- (shape (obj ?r&:(is-box ?r)))
    ?fl <- (shape (name "Line") (obj ?l))
	(test (call ShapePredicate connectsRectangleLine ?r ?l))
    =>
    (printout "recognize linkend = line")
    (bind ?sh (new LinkEnd))
    (?sh setEndShape ?r)
    (?sh setEnd ?l)
    (?sh append ?l)
    (?sh setType (LinkEnd$TYPE.PLAIN))
    (retract ?fr)
    (retract ?fl)
    (assert (shape
            (name "LinkEnd")
            (obj ?sh)
            (children ?l)))
    (recognize ?sh (list-children (create$ ?l))))

(defrule linkend-arrow
    ""
    ?fa <- (shape (obj ?a&:(is-arrow ?a)))
    ?fr <- (shape (obj ?r&:(is-box ?r)))
    (test (call ShapePredicate connectsRectangleLine ?r (?a getShaft)))
    =>
    (printout "recognize linkend = arrow")
    (bind ?sh (new LinkEnd))
    (?sh setEndShape ?r)
    (?sh setEnd ?a)
    (?sh append (?a getShaft))
    (?sh setType (?a getName))
    (retract ?fa)
    (retract ?fr)
    (assert (shape
            (name "LinkEnd")
            (obj ?sh)
            (children ?a)))
    (recognize ?sh (list-children (create$ ?a))))

(defrule linkend-linkend
    ""
    (declare (salience 0))
    ?fk <- (shape (name "LinkEnd") (obj ?k))
    ?fl <- (shape (name "Line") (obj ?l))
	(test (call ShapePredicate meetsLinkEndLine ?k ?l))
    =>
    (printout "recognize linkend = linkend, line")
    (bind ?sh (new LinkEnd))
    (?sh setEndShape (?k getEndShape))
    (?sh setEnd (?k getEnd))
    (?sh setType (?k getType))
    (bind ?v (?k getPath))
    (?v add ?l)
    (?sh setPath ?v)
    (retract ?fk)
    (retract ?fl)
    (assert (shape
            (name "LinkEnd")
            (obj ?sh)
            (children ?k ?l)))
    (recognize ?sh (list-children (create$ ?k ?l))))

(defrule link-linkend
    ""
    ?f1 <- (shape (name "LinkEnd") (obj ?l1))
    ?f2 <- (shape (name "LinkEnd") (obj ?l2&~?l1))
    (test (call ShapePredicate meetsLinkEndLinkEnd ?l1 ?l2))
    =>
    (printout "recognize link = linkend, linkend")
    (bind ?sh (new Link))
    (?sh appendLinkEnd ?l1)
    (?sh appendLinkEnd ?l2)
    (retract ?f1)
    (retract ?f2)
    (assert (shape
            (name "Link")
            (obj ?sh)
            (children ?l1 ?l2)))
    (recognize ?sh (list-children (create$ ?l1 ?l2))))

(defrule link-link
    ""
    ?fl <- (shape (name "Link") (obj ?l))
    ?fe <- (shape (name "LinkEnd") (obj ?e))
    (test (call ShapePredicate meetsLinkLinkEnd ?l ?e))
    =>
    (printout "recognize link = link, linkend")
    (bind ?sh (new Link))
    (?sh setLinkEnds (?l getLinkEnds))
    (?sh appendLinkEnd ?e)
    (retract ?fl)
    (retract ?fe)
    (assert (shape
            (name "Link")
            (obj ?sh)
            (children ?l ?e)))
    (recognize ?sh (list-children (create$ ?l ?e))))





